home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / dataval.exe / VALID1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-22  |  4KB  |  150 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Demo program from the Turbo Vision Guide     }
  5. {                                                }
  6. {   Copyright (c) 1990 by Borland International  }
  7. {                                                }
  8. {************************************************}
  9. {$X+}
  10.  
  11. program TVGUID16;
  12.  
  13. uses Objects, Drivers, Views, Menus, Dialogs, App;
  14.  
  15. type
  16.   DialogData = record
  17.     InputLineData: string[128];
  18.   end;
  19.  
  20.   TMyApp = object(TApplication)
  21.     constructor Init;
  22.     procedure InitStatusLine; virtual;
  23.     procedure NewDialog;
  24.   end;
  25.  
  26.   PDemoDialog = ^TDemoDialog;
  27.   TDemoDialog = object(TDialog)
  28.   end;
  29.  
  30.   PValidInputLine = ^TValidInputLine;
  31.   TValidInputLine = object(TInputLine)
  32.     IsValid: Boolean;
  33.     constructor Init(var Bounds: TRect; AMaxLen: Integer);
  34.     function GetPalette: PPalette; virtual;
  35.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  36.     function Valid(Command: Word): Boolean; virtual;
  37.   end;
  38.  
  39.  
  40. constructor TValidInputLine.Init(var Bounds: TRect; AMaxLen: Integer);
  41. begin
  42.   TInputLine.Init(Bounds, AMaxLen);
  43.   IsValid := Valid(cmOk);
  44. end;
  45.  
  46.  
  47. function TValidInputLine.GetPalette: PPalette;
  48. const AltPalette: String[Length(CInputLine)] = CInputLine;
  49. begin
  50.      { By assigning a palette index number that is out of the range of
  51.        our owner's palette, we automatically get flashing white on red
  52.        for this color entry.  This should instead be mapped to an
  53.        actual palette entry in the owner... }
  54.   AltPalette[1] := #255;
  55.   if IsValid then
  56.     GetPalette := TInputLine.GetPalette
  57.   else
  58.     GetPalette := @AltPalette;
  59. end;
  60.  
  61.  
  62. procedure TValidInputLine.SetState(AState: Word; Enable: Boolean);
  63. begin
  64.     { If we are currently focused and AState is sfFocused, then
  65.       run a data validation... }
  66.   if ((AState and sfFocused) <> 0) and GetState(sfFocused) then
  67.     Valid(cmOk);
  68.   TInputLine.SetState(AState, Enable);
  69. end;
  70.  
  71.  
  72. function TValidInputLine.Valid(Command: Word): Boolean;
  73. begin
  74.   if Command <> cmCancel then
  75.   begin
  76.     IsValid := (Data^ = 'Hello');
  77.     Valid := IsValid;
  78.      write(#7);      { "hear" where & when Valid is called }
  79.     DrawView;     { Show the new colors. }
  80.   end;
  81. end;
  82.  
  83.  
  84. var
  85.   DemoDialogData: DialogData;
  86.  
  87.  
  88. { TMyApp }
  89. constructor TMyApp.Init;
  90. begin
  91.   TApplication.Init;
  92.   NewDialog;
  93. end;
  94.  
  95.  
  96. procedure TMyApp.InitStatusLine;
  97. var R: TRect;
  98. begin
  99.   GetExtent(R);
  100.   R.A.Y := R.B.Y - 1;
  101.   StatusLine := New(PStatusLine, Init(R,
  102.     NewStatusDef(0, $FFFF,
  103.       NewStatusKey('', kbF10, cmMenu,
  104.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  105.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  106.       nil))),
  107.     nil)
  108.   ));
  109. end;
  110.  
  111. procedure TMyApp.NewDialog;
  112. var
  113.   Bruce: PView;
  114.   Dialog: PDemoDialog;
  115.   R: TRect;
  116.   C: Word;
  117. begin
  118.   R.Assign(20, 6, 60, 19);
  119.   Dialog := New(PDemoDialog, Init(R, 'Demo Dialog'));
  120.   with Dialog^ do
  121.   begin
  122.     R.Assign(3, 8, 37, 9);
  123.     Bruce := New(PValidInputLine, Init(R, 128));
  124.     Insert(Bruce);
  125.     R.Assign(2, 7, 37, 8);
  126.     Insert(New(PLabel, Init(R, 'Type: Hello, then Tab around.', Bruce)));
  127.     R.Assign(15, 10, 25, 12);
  128.     Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
  129.     R.Assign(28, 10, 38, 12);
  130.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  131.   end;
  132.   Dialog^.SetData(DemoDialogData);
  133.   C := DeskTop^.ExecView(Dialog);
  134.   if C <> cmCancel then Dialog^.GetData(DemoDialogData);
  135.   Dispose(Dialog, Done);
  136. end;
  137.  
  138. var
  139.   MyApp: TMyApp;
  140.  
  141. begin
  142.   with DemoDialogData do
  143.   begin
  144.     InputLineData := 'Phone home.';
  145.   end;
  146.   MyApp.Init;
  147.   MyApp.Run;
  148.   MyApp.Done;
  149. end.
  150.